Reference file for NHSplots development

Standard Visualisations in Q-Markdown

Author

NHSE-R

Published

October 20, 2022

1 Visualisations

#load packages
source("R/nhs_style.R")
library(ggrepel)
library(tidyverse)
library(dplyr)
library(gapminder)
library(lemon) # for axis options
library(formattable)
library(sf) # spatial data

1.1 Bar Charts

Reference (see Figure 1).

Show code
#Prepare data
bar_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  arrange(desc(lifeExp)) %>%
  head(5)

#Make plot
ggplot(bar_df, aes(x = reorder(country, desc(lifeExp)), y = lifeExp, label = round(lifeExp, digits = 0))) +
  geom_col(fill= nhs_palette("nhs_blues")) +
  geom_label(nudge_y = -5, size = 5) +
  # theme(axis.text.x = element_text(angle=45, vjust=1, hjust=1)) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  labs(title="Bar Chart Title",
       subtitle = "Bar Chart Sub-Title",
       x = "Country",
       y = "Life Expectancy (Years)"
       )

Figure 1: Life Expectancy in Africa, 2007. Data source (Bryan 2017)

1.1.1 Bar chart with highligted value

Show code
#Prepare data
bar_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  arrange(desc(lifeExp)) %>%
  head(5)

# Find max life expectancy
maxLife <- bar_df[which.max(bar_df$lifeExp), ]

#Make plot
ggplot(bar_df, aes(x = reorder(country, desc(lifeExp)), y = lifeExp)) +
  geom_bar(stat="identity", 
           position="identity", 
           fill="#005EB8") +
  geom_bar(stat="identity", position="identity", fill=ifelse(bar_df$country == maxLife$country, "#005EB8", "#dddddd")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  labs(subtitle = paste(
            "Life expectancy in",
            maxLife$country,
            "is",
            format(round(maxLife$lifeExp, 0), nsmall = 0),
            "Years"
            ), 
            x = "Country",
            y = "Life Expectancy (Years)"
       )

Figure 2: Life Expectancy in Africa, 2007. Data source (Bryan 2017)

1.1.2 Horizontal Bar Chart

Show code
#Prepare data
bar_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  arrange(desc(lifeExp)) %>%
  head(5)

#Make plot
ggplot(bar_df, aes(x = reorder(country, lifeExp), y = lifeExp)) +
  geom_bar(stat="identity", 
           position="identity", 
           fill="#005EB8") +
  # theme(axis.text.x = element_text(angle=45, vjust=1, hjust=1)) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  coord_flip() +
  theme(panel.grid.major.x = element_line(color="#cbcbcb"), 
        panel.grid.major.y=element_blank()) +
  labs(x = "Country",
    y = "Life Expectancy (Years)"
    )

Figure 3: Life Expectancy in Africa, 2007. Data source (Bryan 2017)

1.1.3 Pyramid Chart

Show code
set.seed(100)
a <- seq(from = 0, to = 90, by = 10)
d <- data.frame(age = paste(a, a + 10, sep = "-"),
                sex = rep(x = c("Female", "Male"), each = 10),
                pop = sample(x = 1:100, size = 20)+100)

ggplot(data = d, 
       mapping = aes(x = ifelse(test = sex == "Male", yes = -pop, no = pop), 
                     y = age, fill = sex)) +
  geom_col() +
  scale_x_symmetric(labels = abs) +
  labs(x = "Population Count",
       y = "Age Group (Years)") +
  nhs_style() +
  scale_fill_discrete(breaks=c("Male","Female")) # sort legend lable order

Figure 4: Age / sex distribution.

1.2 Line Charts

1.2.1 Line chart with latest value KPI

Show code
#Prepare data
line_df <- gapminder %>%
  filter(country == "Malawi")

# get latest metric value for KPI
latestDate <- max(line_df$year)
latestDate_value <- line_df %>% 
      filter(year == latestDate)

#Make plot
ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(colour = "#005EB8", size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  ylim(c(0, max(line_df$lifeExp)+10)) + # add space above line
  labs(subtitle = paste(
            "Life expectancy in Malawi is",
            format(round(latestDate_value$lifeExp, 0), nsmall = 0),
            "as of",
            format(latestDate, format="%Y")
       )
  )

Figure 5: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

Show code
test <- (paste("Life expectancy in Malawi is",
      format(round(latestDate_value$lifeExp, 0), nsmall = 0),
      "as of",
      format(latestDate, format="%Y")
      ))

latest_date <- paste(format(latestDate, format="%Y"))

Life expectancy in Malawi is 48 as of 2007

This is my 2007 located somewhere in my Markdown document.

todo:

  1. Function to create KPI sub-titles

1.2.2 Line chart with target line and lable

Show code
# prepare data
line_df <- gapminder %>%
  filter(country == "Malawi")

# get latest metric value for KPI
latestDate <- max(line_df$year)
latestDate_value <- line_df %>% 
      filter(year == latestDate)

# make plot
ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(colour = "#005EB8", size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  geom_hline(yintercept=45,  # taget line options
      linetype='dashed',
      size = 1.5,
      colour='#425563') +
  geom_label(                # taget lable options
      aes(
            x = 1952,
            y = 45, label = "Target (45 Years)"
      ),
      hjust = 0.15, 
      vjust = -.3, 
      colour = "#425563", 
      fill = "white", 
      label.size = NA, 
      family="Helvetica", 
      size = 6) +
  nhs_style() +
  ylim(c(0, max(line_df$lifeExp)+10)) # add space above line

Figure 6: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

todo:

  1. Function to add target as variable with adjustments

1.2.3 Line chart with error bars

Show code
# prepare data
line_df <- gapminder %>%
  filter(country == "Malawi")

# random errors
error <- abs(rnorm(nrow(line_df))+3)

# add error bars
line_df$lowerci = line_df$lifeExp - error
line_df$upperci = line_df$lifeExp + error

# get latest metric value for KPI
latestDate <- max(line_df$year)
latestDate_value <- line_df %>% 
      filter(year == latestDate)

# make plot
ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(colour = "#005EB8", size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  geom_hline(yintercept=45,  # taget line options
      linetype='dashed',
      size = 1.5,
      colour='#425563') +
  geom_label(                # taget lable options
      aes(
            x = 1952,
            y = 45, label = "Target (45 Years)"
      ),
      hjust = 0.15, 
      vjust = -.3, 
      colour = "#425563", 
      fill = "white", 
      label.size = NA, 
      family="Helvetica", 
      size = 6) +
  nhs_style() +
  ylim(c(0, max(line_df$lifeExp)+10)) + # add space above line +
  geom_errorbar(data = line_df, aes(x = year, 
                             ymin = lowerci,
                             ymax = upperci),
                             width = 1.2,
                             size = 0.3,
                             alpha = 0.5)

Figure 7: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

1.3 Multi-Line Chart with data lables

Show code
#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Algeria","Libya", "Mauritius", "Reunion", "Tunisia"))

latest_values <- line_df %>%
  top_n(1, year) 

#Make plot
ggplot(line_df, aes(x = year, y = lifeExp, xend = 2010, yend = 100, colour = country)) +
  geom_line(size = 1) +
  scale_color_manual(values=nhs_palette("nhs_blues")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  theme(legend.position="none", 
        plot.margin = margin(0,2,0,0, "cm")) +
  labs(title="Line Chart Title",
       subtitle = "Line Chart Sub-Title",
       x = "Year",
       y = "Life Expectancy (Years)"
      ) +
  coord_cartesian(clip = "off") +
  geom_label_repel(
    aes(label = paste(
            country,
            ": ",
            round(lifeExp, digits = 0),
            sep = ""
            )),
    data = latest_values, 
    size = 4,
    nudge_x = 0, direction = "y", hjust = "left",
    xlim = c(-Inf, Inf),
    ylim = c(-Inf, Inf),
    fill = "white",
    min.segment.length = Inf
    )

Figure 8: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

1.4 Multi-Line Chart with Region Colours

Show code
#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Afghanistan","Albania","Algeria","Angola","Argentina","Australia","Austria","Bahrain","Bangladesh","Belgium","Benin"))

#Make plot
ggplot(line_df, aes(x = year, y = lifeExp, colour = country)) +
  geom_line(size = 1) +
  scale_color_manual(values=nhs_palette("midlands_region")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  theme(legend.position = "top", plot.margin = margin(0,0,0,0, "cm")) +
  labs(title="Line Chart Title",
       subtitle = "Line Chart Sub-Title",
       x = "Year",
       y = "Life Expectancy (Years)"
      )

Figure 9: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

1.5 Small Multiples

Show code
#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Afghanistan","Albania","Algeria","Angola","Argentina","Australia","Austria","Bahrain","Bangladesh","Belgium","Benin"))

ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(aes(color = "red"),
            size = 1.5)+
  facet_wrap(~ country, ncol = 3, strip.position = "top")+
  labs(title = "Life expectancy 1952-2007",
       x = "Year",
       y = "Life Expectancy (Years)",
       caption = "Source: Public Health England National flu and COVID-19 surveillance report (week 8, provisional).") +
  scale_y_continuous(limits = c(0,100)) +
  theme(panel.background = element_blank(),
        strip.text = element_text(face = "bold", color = "black"),
        strip.background = element_rect(color = "black", fill = "white"),
        legend.position = "none")
  #scale_x_continuous(breaks=c(1952,2007))+
  #theme(axis.ticks = element_blank(), legend.position = "none") +
  #nhs_style_sm()

Figure 10: Life expectancy 1952-2007. Data source (Bryan 2017)

1.6 Small Table

Show code
#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Afghanistan","Albania","Algeria","Angola","Argentina","Australia","Austria","Bahrain","Bangladesh","Belgium","Benin"))

# data
latest_values <- line_df %>%
  top_n(1, year) %>%  
  mutate_if(is.numeric, round, digits = 0) %>%
  arrange(desc(lifeExp))

colnames(latest_values) <- c("Country", "Continent", "Year", "Life Expectancy", "Poulation", "GDP Per Capita")

improvement_formatter <- formatter("span", 
    style = x ~ style(font.weight = "bold", 
    color = ifelse(x > 8000, customGreen, ifelse(x < 8000, customRed, "black"))), 
    x ~ icontext(ifelse(x>8000, "arrow-up", "arrow-down"), x)
    )

benchmark <- formatter("colorbar", style = x ~ style(display = "block", 
        padding = "0 4px",
        `border-radius` = "4px",
        #width = "40px",
        `background-color` = ifelse(x > 70,
                   customGreen, ifelse(x < 70, customRed, "black")),
                   NA)
                   )

# Table
latest_values |>
formattable(align =c("l","c","c","r","r","r"), 
            list(`Country` = formatter(
              "span", style = ~ style(display = "block", 
        padding = "0 4px", `border-radius` = "4px", color = "white", `background-color` = nhs_palette("midlands_region"),font.weight = "bold")), 
            `Life Expectancy` = benchmark,
            `GDP Per Capita` = improvement_formatter
            ))#, table.attr = 'style="font-size: 20px;";\"')

Life expectancy 1952-2007.

Country
Continent
Year
Life Expectancy
Poulation
GDP Per Capita
Australia
Oceania
2007
81
20434176
34435
Austria
Europe
2007
80
8199783
36126
Belgium
Europe
2007
79
10392226
33693
Albania
Europe
2007
76
3600523
5937
Bahrain
Asia
2007
76
708573
29796
Argentina
Americas
2007
75
40301927
12779
Algeria
Africa
2007
72
33333216
6223
Bangladesh
Asia
2007
64
150448339
1391
Benin
Africa
2007
57
8078314
1441
Afghanistan
Asia
2007
44
31889923
975
Angola
Africa
2007
43
12420476
4797

1.7 Sparklines

Show code
reactable(
  sparkline_df,
  defaultPageSize = 11,
  columns = list(
    Country = colDef(maxWidth = 120),
    Continent = colDef(maxWidth = 120),
    `GDP Per Capita` = colDef(maxWidth = 170),
    `Life Expectancy (1950-2007)` = colDef(
      cell = react_sparkline(sparkline_df,
        height = 40,
        highlight_points = highlight_points(all='blue'),
        show_area = TRUE,
        line_width = 2,
        labels = c("first", "last"),
        label_size = "1.0em"))
    )
  )

1.8 Deviation Plot

Example graph for displaying deviations from a common reference point or baseline.

Show code
#make data
df <- data.frame(trt=rep(c("Dose 1", "Dose 2", "Dose 3"), each=4),
                 visit=rep(c(1, 2, 3, 4),3),
                 response=c(0, 0.7, 0.8, 0.6, 
                            0, 0.5, 0.6, 0.2,
                            0, -0.2, -0.6, -0.9 ))

ggplot(df, aes(x=visit, y=response, group=trt, colour=trt)) + 
  geom_hline(yintercept = 0, size = 1, colour="#333333") + 
  geom_point(size=3) +
  geom_line(size=1) +
  scale_y_continuous(limits = c(-1, 1), breaks = c(-1,-0.5,0,0.5,1)) +
  nhs_style() +
  labs(y = "Response",
       x = "Visits"
       )

Figure 11: Deviation

1.9 Correlation Plot

For displaying the relationship between them two or more variables.

Show code
set.seed(1984)
# Create some data
df <- data.frame(cause=c(runif(40,1,10))   )
df$effect <- df$cause*(rnorm(40,2,0.5)) + rnorm(40,0,1)

ggplot(df, aes(x=cause, y=effect)) + 
  geom_point(size=4.5, shape = 16,position="jitter") +
  geom_smooth(method = "lm") +        
  scale_y_continuous(expand=c(0,0.5)) +
  scale_x_continuous(expand=c(0,0.5)) +
  nhs_style() +
  labs(y = "Effect",
       x = "Cause"
       )

Figure 12: Correlation

1.10 Scatter Plots

Show code
# prepare data
data("midwest", package = "ggplot2")
options(scipen=999)  # turn-off scientific notation like 1e+48

# make plot
ggplot(midwest, aes(x=area, y=poptotal)) + 
  geom_point(aes(col=state, size=popdensity)) + 
  xlim(c(0, 0.1)) + 
  ylim(c(0, 500000)) + 
  labs(y="Population", x="Area") +
  nhs_style()

Figure 13: Population vs land area in mid-western USA.

1.11 Box Plot

Show code
# Plot
g <- ggplot(mpg, aes(class, cty))
g + geom_boxplot(varwidth=T, fill="#005EB8") + 
    labs(
         x="Class of Vehicle",
         y="City Mileage") +
    nhs_style()

Figure 14: City Mileage grouped by class of vehicle, USA.

1.12 Tables

Show code
# data
line_df <- gapminder %>%
  filter(country %in% c("Algeria","Libya", "Mauritius", "Reunion", "Tunisia"))

latest_values <- line_df %>%
  top_n(1, year) %>%  
  mutate_if(is.numeric, round, digits = 0) %>%
  arrange(desc(lifeExp))

colnames(latest_values) <- c("Country", "Continent", "Year", "Life Expectancy", "Poulation", "GDP Per Capita")

improvement_formatter <- formatter("span", 
    style = x ~ style(font.weight = "bold", 
    color = ifelse(x > 8000, customGreen, ifelse(x < 8000, customRed, "black"))), 
    x ~ icontext(ifelse(x>8000, "arrow-up", "arrow-down"), x)
    )

# Table
formattable(latest_values,
            align =c("l","c","c","r","r","r"), 
            list(`Country` = formatter(
              "span", style = ~ style(color = "grey",font.weight = "bold")), 
            `Life Expectancy` = color_tile(customGreen0, customGreen),
            `GDP Per Capita` = improvement_formatter
            ))

Life expectancy in Africa 1952-2007.

Country
Continent
Year
Life Expectancy
Poulation
GDP Per Capita
Reunion
Africa
2007
76
798094
7670
Libya
Africa
2007
74
6036914
12057
Tunisia
Africa
2007
74
10276158
7093
Mauritius
Africa
2007
73
1250882
10957
Algeria
Africa
2007
72
33333216
6223

Data source (Bryan 2017)

2 Maps

Show code
Metric <- mapData$colourvalue

ggplot() +
    geom_sf(data = ukMap, fill= "antiquewhite") +
    geom_sf(data = mapData, fill= mapData$hex_colour) +
    theme(panel.grid.major = element_line(
      color = gray(.3),
    linetype = "dashed",
    size = 0.3),
    panel.background = element_rect(
      fill = "aliceblue")) +
    coord_sf(xlim = c(-6, 2), ylim = c(50,56)) #+
    #geom_text_repel(data = mapData ,aes(x = LONG,
                    #y = LAT,
                    #nudge_x = 5,
                    #nudge_y = 53,
                    #label = ICB22NM.x)
                    #)

Figure 15: ICB Map.

Show code
londonMap <- mapData %>%
  filter(NHSEREGCD %in% c("Y56"))

ggplot() +
    geom_sf(data = londonMap, fill = "#00A499", colour = "#FFFFFF", lwd = 1.5) +
    theme(panel.background = element_rect(fill = "white"),
          axis.title=element_blank(),
          axis.text=element_blank(),
          axis.ticks=element_blank(),
          plot.title = element_text(colour = "#005EB8", size = 60),
          plot.subtitle = element_text(colour = "#005EB8", size = 25)) +
    labs(title = londonMap$NHSEREGNM,
         subtitle = "England")

Figure 16: London ICB Map.

2.1 Hex Map

Ref: https://open-innovations.org/blog/2022-07-19-nhs-pcns-as-a-hex-cartogram

Show code
hexData <- hexData %>%
  filter(Region.Code %in% c("Y56"))

ggplot() +
    geom_sf(data = hexData, fill= hexData$colour) +
    theme(panel.background = element_rect(fill = "white"),
          axis.title=element_blank(),
          axis.text=element_blank(),
          axis.ticks=element_blank())

Figure 17: London ICB Hex Map.

3 References

Bryan, Jennifer. 2017. Gapminder R Package.